00100		SUBROUTINE QUADO
00200		COMMON XS(100),YS(100),N,X1(512),Y1(512),QS(100),K
00220		COMMON/RD/ TM(50),SP1(50),SP2(50),SFAC(512)/XX/F(5,512)
00280		COMMON/DP/IP(1),ISU(1400)
00300		DIMENSION ARY(9),FAC(4)
00500	       DATA  ARY/45H(' ARRAY F',I2,'(512); SEG(F',I2,');0  999')  /
00900	C  /DEG OR X/DIS OR Y/CEN OF CIRC X/CEN OF CIRCLE Y/(CALLS QUAD)/
01000		EQUIVALENCE(XA,FAC(1)),(XB,FAC(2)),(XC,FAC(3)),(XD,FAC(4))
01110		ARY(3)=5H',I1,
01155		ARY(7)=5HI1,')
01170		TIME1=0
01200		XC=0
01300		XD=0
01400		JTIME=64
01600	C COUNTER IS TO 0 1ST CELL OF DPPLR ARRAY(SPD IS NOT KNOWN YET)
01700	
01800	
01900	CC	GO TO 1
02000	
02100	
02200	CC	IF(NL.EQ.-14.OR.NL.EQ.-16)GO TO 1
02210	C  NEXT FOR CIRCLES**********
02300	C   -14 OR -16=X,Y SYSTEM
02400	CC	DG=P(IPAR-4)
02500	C   DG=DEGREES
02600	CC	DIS=P(IPAR-3)
02700	C   RADIUS OF CIRCLE
02800	CC	XX=P(IPAR-2)
02900	CC	YY=P(IPAR-1)
03000	C   XX,YY IS CENTER OF CIRCLE
03100	CC	X=DIS*SIND(DG)+XX
03200	CC	Y=DIS*COSD(DG)+YY
03500	CC	GO TO 6
03600	
03700	1	DO 5 KQ=1,512
03750		FX=SFAC(KQ)
03760	CC	KF2=SFAC(KQ+1)
03770	CC	IF(KQ.EQ.512)KF2=512
03775		FX=KQ
03777	C******************
03780		KF=FX
03800		X=X1(KF)
03900		Y=Y1(KF)
04000		IF(KQ.NE.JTIME)GO TO 6
04005		J=X*10
04007		K=Y*10
04010		CALL AIVECT(J,K)
04100	C  PUTS MARK EACH 1/8 OF PATH (NONE AT START)
04110		CALL AVECT(J+7,K)
04120		CALL AVECT(J+7,K+7)
04130		CALL AVECT(J,K+7)
04140		CALL AVECT (J,K)
04240		JTIME=JTIME+64
04300	6	DIS=SQRT(X**2+Y**2)
04310	CC	DISNXT=SQRT(X1(KF2)**2+Y1(KF2)**2)
04320	CC	DIS=DIS+(FX-KF)*(DISNXT-DIS)
04330	C  FOR VARIABLE SPEED THROUGH ARRAY. INTERPOLATES BETWEEN POINTS.
04400	C   DIST. OF SOUND FROM LISTENER
04500		IQUAD=1
04600		S=X
04700		T=Y
04800		XX=ABS(X)
04900		YY=ABS(Y)
05000	C   NEXT FINDS QUADRANT
05100		IF(X.LT.YY)GO TO 7
05200		IQUAD=2
05300		S=-Y
05400		T=X
05500		GO TO 3
05600	7	IF(-Y.LT.XX)GO TO 4
05700		IQUAD=3
05800		S=-X
05900		T=-Y
06000		GO TO 3
06100	4	IF(-X.LE.YY)GO TO 3
06200		IQUAD=4
06300		S=Y
06400		T=-X
06500	3	XA=.5-S/(T*2)
06600		XB=1-XA
06700	C   % OF SNUND IN EACH "FRONT" SPEAKER
06800		IF(DIS.GE.14.14215)GO TO 30
06900	C   OUTSIDE OF SPEAKER CIRCLE, THEN JUMP
07000	CC	X=1-DIS/14.14215
07100		X=(1-DIS/14.14215)**2
07200	C   FACTOR (OR TRY? (1-DIS/14.14215)**2  )
07300		XA=XA+(1-XA)*X
07400		XB=XB+(1-XB)*X
07500		XC=XB*X
07600		XD=XA*X
07700	C   SUM OF FACTORS WILL BE FROM 1(AT EDGE) TO 4(AT CENTER)
07800		GO TO 31
07900	30	X=1-((DIS-14.14215)/DIS)**2
08000	C   OUTSIDE CIRCLE (TRY ALSO SANS **)
08100		XA=XA*X
08200		XB=XB*X
08300	C31	N=IPAR-5
08400	31	IQUAD=IQUAD-1
08500		DO 2 K=1,4
08600		J=IQUAD+K
08700		IF(J.GT.4)J=J-4
08800	2	F(J,KQ)=FAC(K)
08900	C  SETS DIR. SIG. MULTIPLIERS FOR EACH SPKR
09000		T=FX-TIME1
09100		V=(DIS1-DIS)/T
09200		F(5,KQ)=DIS1/(DIS1-V)
09300	C   F(5,N) IS FREQ MULTIPLIER FOR DOPPLER SHIFT
09400		TIME1=FX
09500		DIS1=DIS
09600	C   SAVE DIS AND TIME FOR NEXT TIME AROUND
09800	C   ZERO FREQ MULTIPLIER FIRST TIME.
09900	C   IN FUNCTION IT WILL BE MADE EQUAL TO SECOND SLOT
10000	5	CONTINUE
10100	C   CAN BE USED FOR 2 CHANS.  BUT 5 PARAMS STILL NEEDED.
10110		F(5,1)=0
10200	
10300	
10400		DO 777 K=512,1,-1
10500	777	IF(F(5,K).EQ.0)F(5,K)=F(5,K+1)
10600	C  FIXES UP ZERO MULTIPLIERS IN DOPPLER FUNC.
10700	77	M=1
10800		IB=-466
10900		J=256
11000		RM=200.
11100		DO 8 K=1,4
11200		IF(M.NE.2)GO TO 88
11300		M=5
11400		RM=300.
11500	C  TO ENLARGE DPY OF DOPPLER
11600		IB=-88
11700		J=106
11800	88	JB=F(M,1)*RM+J
11900	C   DRAWS DOPPLER FUNC.
12000	CC	CALL AIVECT(IB,JB)
12100	CC	DO 9 L=2,512,3
12200	CC	I=IB+L/2
12300	CCC   REDUCES TO FIT 1/4 OF SCREEN
12400	CC
12450	CC	JB=F(M,L)*RM+J
12500	CC9	CALL AVECT(I,JB)
12600		IF(M.NE.5)GO TO 99
12700		RM=200.
12800		M=2
12900		J=256
13000		IB=250
13100	C  GOES BACK TO DRAW SPKR B FUNC.
13200		GO TO 88
13300	99	M=M+1
13400		IB=250
13500		IF(M.EQ.3)J=-440
13600		IF(M.EQ.4)IB=-466
13700	8	CONTINUE
13800	
15500	CC	CALL DPYOUT(1)
15600		TYPE 112
15700		ACCEPT 113,NAME,NJ,LB
15800	333	IF(LB.EQ.0)GO TO 130
15900	C   JUMP IF NOT SAVING DPY BUFFER
16000		IP(1)=IP(3)+2
16100	C   IP(3) IS REALLY ISU(2).  I.E. WDCNT
16200	CC	CALL SAVB(IP)
16300	C   WRITES A BINARY FILE OF DPY BUFFER FOR "PLTVEC"
16400	130	IF(NAME.EQ.' '.OR.NAME.EQ.'B')RETURN
16800		REWIND  23
16900		CALL OFILE(23,NAME)
17000		DO 10 K=1,5
17100		IF(NJ.LT.10)GO TO 100
17200		ARY(3)=5H',I2,
17300		ARY(7)=5HI2,')
17400	100	WRITE(23,ARY)NJ,NJ
17500	101	WRITE(23,12)(F(K,N),N=1,512)
17600	10	NJ=NJ+1
17700		END FILE 23
17800		TYPE 114,NAME
18000	12	FORMAT(16F8.5/)
18100	112	FORMAT(' TYPE FILE NAME AND 1ST FUNC # --  '$)
18200	113 	FORMAT(A5,2I)
18300	114	FORMAT(' FUNCTIONS ARE IN ',A5,'.DAT'/)
18350		CALL EXIT
18400		END